home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 09 / 3 / DISK0932.ZIP / SOURCE.EXE / arc / EVALUATE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-31  |  18KB  |  576 lines
  1.          {           DOUG STANDING / MAX VON BIRDFACE  1/22/87 / 6/90     }
  2.  
  3.          {  This program is a computerized employee evaluation routine.   }
  4.          {  Input is easy and quite a bit of the printing and organizing  }
  5.          {  of the form is done automatically and in a personalized way.  }
  6.          {  Note: Procedure LBCOAT and call to it at end of main program. }
  7.          {  This is an Assignment/Execute procedure passing control back  }
  8.          {  to LABCOAT.COM.  This is only to be used when that file      }
  9.          {  exists on the same disk with EVALUATE compiled to COM file -  }
  10.          {  else just remove it, and this program runs free-standing.     }
  11.  
  12.  
  13. PROGRAM EVALUATE;     { v3.6 copyright 6/90 }
  14.  
  15. TYPE
  16.   STRINGTYPE = STRING[80];
  17.  
  18. VAR
  19.   CH : CHAR;
  20.   I : INTEGER;
  21.   ADAPTABILITY, ATTENDANCE, ATTITUDE : REAL;
  22.   JUDGEMENT, INITIATIVE, KNOWLEDGE : REAL;
  23.   HELPFULNESS, PTAWARENESS, ACCURACY : REAL;
  24.   TELEPHONE, GROOMING, SCORE, SCORE1 : REAL;
  25.   DATE, DATE2, DATE3, DEPARTMENT, NAME,PLACE : STRINGTYPE;
  26.  
  27. PROCEDURE LBCOAT;         { go back to LABCOAT program }
  28.  
  29.   VAR
  30.     LABCOAT:FILE;
  31.  
  32.   BEGIN
  33.     ASSIGN(LABCOAT,'LABCOAT.COM');
  34.     EXECUTE(LABCOAT);
  35.   END;
  36.  
  37. PROCEDURE CLEARLINES;            { clears lines 23 & 24 }
  38.  
  39.   BEGIN
  40.     GOTOXY(1,23);
  41.     TEXTBACKGROUND(1);
  42.     CLREOL;
  43.     GOTOXY(1,24);
  44.     TEXTBACKGROUND(1);
  45.     CLREOL;
  46.     TEXTBACKGROUND(1);
  47.   END;
  48.  
  49. PROCEDURE MAKEaLINE;              { for screen borders }
  50.  
  51.   BEGIN
  52.     FOR I := 1 TO 80 DO
  53.     WRITE(CHR(205));
  54.   END;
  55.  
  56. PROCEDURE SIGNON;                            { initial screen }
  57.  
  58.   BEGIN
  59.     TEXTBACKGROUND(1);
  60.     GRAPHBACKGROUND(1);
  61.     CLRSCR;
  62.       GOTOXY(1,7);
  63.       TEXTCOLOR(0);
  64.       MAKEaLINE;
  65.       GOTOXY(1,8);
  66.       TEXTCOLOR(4);
  67.       MAKEaLINE;
  68.       GOTOXY(1,9);
  69.       TEXTCOLOR(15);
  70.       MAKEaLINE;
  71.       GOTOXY(1,10);
  72.       TEXTCOLOR(2);
  73.       MAKEaLINE;
  74.       GOTOXY(1,11);
  75.       TEXTCOLOR(0);
  76.       MAKEaLINE;
  77.       GOTOXY(13,13);
  78.       HIGHVIDEO;
  79.       TEXTBACKGROUND(1);
  80.       TEXTCOLOR(4);
  81.       WRITELN('***** MEDICAL WORKER EVALUATION FORM  Version 3.6 *****');
  82.       WRITELN('                                    by                    ');
  83.       WRITELN('                      Doug Standing and M. Von Birdface    ');
  84.       GOTOXY(1,17);
  85.       TEXTCOLOR(0);
  86.       MAKEaLINE;
  87.       GOTOXY(1,18);
  88.       TEXTCOLOR(2);
  89.       MAKEaLINE;
  90.       GOTOXY(1,19);
  91.       TEXTCOLOR(15);
  92.       MAKEaLINE;
  93.       GOTOXY(1,20);
  94.       TEXTCOLOR(4);
  95.       MAKEaLINE;
  96.       GOTOXY(1,21);
  97.       TEXTCOLOR(0);
  98.       MAKEaLINE;
  99.       DELAY(6000);
  100.       HIGHVIDEO;
  101.       CLRSCR;
  102.   END;
  103.  
  104. PROCEDURE SHOW;
  105.  
  106.   BEGIN
  107.     TEXTBACKGROUND(1);
  108.     TEXTCOLOR(0);
  109.     WRITELN('You will be evaluating ',NAME,' for 11 key characteristics.');
  110.     WRITE('Each characteristic is to be assigned');
  111.     WRITELN(' a value from ''1 to 5''.');
  112.     WRITELN;
  113.     LOWVIDEO;
  114.     TEXTBACKGROUND(1);
  115.     WRITELN('     `1'' means ',NAME,' performs Poorly.');
  116.     WRITELN('     `2'' means ',NAME,' just Barely Gets By.');
  117.     WRITELN('     `3'' means ',NAME,' does Acceptable Work.');
  118.     WRITELN('     `4'' means ',NAME,' delivers Good Performance.');
  119.     WRITELN('     `5'' means ',NAME,' does Exceptional Work.');
  120.     WRITELN;
  121.     HIGHVIDEO;
  122.     TEXTBACKGROUND(1);
  123.     TEXTCOLOR(4);
  124.     WRITE('You must rate each of the 11 ');
  125.     WRITELN(' characeristics in the range of `1'' to `5''.');
  126.     TEXTCOLOR(0);
  127.     WRITELN('After you have rated the 11th catagory,');
  128.     WRITELN('all details of the evaluation can be printed.');
  129.     WRITELN;
  130.     WRITELN;
  131.   END;
  132.  
  133. PROCEDURE ID;
  134.  
  135.   BEGIN
  136.     MEM[$40:$17]:=MEM[$40:$17] OR $40;    { toggle on CAPS LOCK }
  137.     LOWVIDEO;
  138.     TEXTBACKGROUND(1);
  139.     WRITE('Enter name of place where employed:     ');
  140.     HIGHVIDEO;
  141.     TEXTBACKGROUND(1);
  142.     READLN(PLACE);
  143.     LOWVIDEO;
  144.     TEXTBACKGROUND(1);
  145.     WRITE('Enter the name of the person you''re rating:     ');
  146.     HIGHVIDEO;
  147.     TEXTBACKGROUND(1);
  148.     READLN(NAME);
  149.     LOWVIDEO;
  150.     TEXTBACKGROUND(1);
  151.     WRITE('Enter ',NAME,'''s job title at the Clinic:     ');
  152.     HIGHVIDEO;
  153.     TEXTBACKGROUND(1);
  154.     READLN(DEPARTMENT);
  155.     LOWVIDEO;
  156.     TEXTBACKGROUND(1);
  157.     WRITE('Enter the date of this evaluation (MM/DD/YY):     ');
  158.     HIGHVIDEO;
  159.     TEXTBACKGROUND(1);
  160.     READLN(DATE);
  161.     LOWVIDEO;
  162.     TEXTBACKGROUND(1);
  163.     WRITE('Enter the last evaluation date (MM/DD/YY):     ');
  164.     HIGHVIDEO;
  165.     TEXTBACKGROUND(1);
  166.     READLN(DATE2);
  167.     LOWVIDEO;
  168.     TEXTBACKGROUND(1);
  169.     WRITE('Enter the starting date of ',NAME,'''s employment here:     ');
  170.     HIGHVIDEO;
  171.     TEXTBACKGROUND(1);
  172.     READLN(DATE3);
  173.     LOWVIDEO;
  174.     TEXTBACKGROUND(1);
  175.     SCORE1:=0;
  176.     WRITE
  177.     ('Enter ',NAME,'''s last evaluation score, if known ');
  178.     TEXTCOLOR(15);
  179.     WRITE('(0 if unknown):    ');
  180.     HIGHVIDEO;
  181.     TEXTBACKGROUND(1);
  182.     READLN(SCORE1);
  183.     WRITELN;
  184.     WRITELN;
  185.   END;
  186.  
  187. PROCEDURE MAKEaBORDER (VAR OUTFILE:TEXT);
  188.  
  189.   BEGIN
  190.       TEXTBACKGROUND(1);
  191.       TEXTCOLOR(0);
  192.         FOR I := 1 TO 80 DO
  193.           WRITE(LST,CHR(61));   { best with Epson - IBM char set nice with 205}
  194.           WRITELN(LST);
  195.   END;
  196.  
  197. PROCEDURE SIGNitSUCKER;
  198.  
  199.   BEGIN
  200.     WRITELN(LST);
  201.     MAKEaBORDER(LST);
  202.     WRITELN(LST);
  203.     WRITELN(LST);
  204.     WRITELN(LST,'Signature of evaluator:_________________________________');
  205.     WRITELN(LST);
  206.     WRITELN(LST,'Signature of employee:__________________________________');
  207.     WRITELN(LST);
  208.     MAKEaBORDER(LST);
  209.     WRITE(LST, CHR(12));
  210.     WRITELN(LST);
  211.     WRITELN(LST,'                        FOR ',NAME,'''s EVALUATION OF ',DATE);
  212.     WRITELN(LST);
  213.     MAKEaBORDER(LST);
  214.     WRITELN(LST);
  215.     WRITELN(LST,'                        MAJOR STRENGTH AREAS FOR ',NAME);
  216.     WRITELN(LST);
  217.     IF (ACCURACY) > 4 THEN WRITELN(LST,'          ACCURACY');
  218.     IF (KNOWLEDGE) > 4 THEN WRITELN(LST,'          JOB KNOWLEDGE');
  219.     IF (TELEPHONE) > 4 THEN WRITELN(LST,'          TELEPHONE SKILLS');
  220.     IF (JUDGEMENT) > 4 THEN WRITELN(LST,'          GOOD JUDGEMENT SKILLS');
  221.     IF (INITIATIVE) > 4 THEN WRITELN(LST,'          INITIATIVE');
  222.     IF (ADAPTABILITY) > 4 THEN WRITELN
  223.     (LST,'          PLANNING/ORGANIZATIONAL SKILLS');
  224.     IF (ATTITUDE) > 4 THEN WRITELN(LST,'          WORK ATTITUDE');
  225.     IF (ATTENDANCE) > 4 THEN WRITELN(LST,'          ATTENDANCE HABITS');
  226.     IF (GROOMING) > 4 THEN WRITELN
  227.     (LST,'          GOOD ATTENDANCE TO APPEARANCE');
  228.     IF (PTAWARENESS) > 4 THEN WRITELN(LST,'          PATIENT RELATIONS');
  229.     IF (HELPFULNESS) > 4 THEN WRITELN
  230.     (LST,'          HELPFUL, SUPPORTIVE ATTITUDE');
  231.     WRITELN(LST);
  232.     MAKEaBORDER(LST);
  233.     WRITELN(LST);
  234.     WRITELN(LST,'                        WEAKER AREAS FOR ',NAME);
  235.     WRITELN(LST);
  236.     IF (ACCURACY) < 3 THEN WRITELN(LST,'          ACCURACY CONCERNS');
  237.     IF (KNOWLEDGE) < 3 THEN WRITELN
  238.     (LST,'          JOB KNOWLEDGE OR EXPERIENCE');
  239.     IF (TELEPHONE) < 3 THEN WRITELN(LST,'          TELEPHONE SKILLS');
  240.     IF (JUDGEMENT) < 3 THEN WRITELN(LST,'          JUDGEMENT SKILLS');
  241.     IF (INITIATIVE) < 3 THEN WRITELN(LST,'          INITIATIVE');
  242.     IF (ADAPTABILITY) < 3 THEN WRITELN
  243.     (LST,'          PLANNING/ORGANIZING SKILLS');
  244.     IF (ATTITUDE) < 3 THEN WRITELN(LST,'          ATTITUDE');
  245.     IF (ATTENDANCE) < 3 THEN WRITELN(LST,'          ATTENDANCE / PUNCTUALITY');
  246.     IF (GROOMING) < 3 THEN WRITELN(LST,'          APPEARANCE');
  247.     IF (PTAWARENESS) < 3 THEN WRITELN(LST,'          PATIENT RELATIONS');
  248.     IF (HELPFULNESS) < 3 THEN WRITELN(LST,'          HELPFULNESS');
  249.     WRITELN(LST);
  250.     MAKEaBORDER(LST);
  251.     WRITELN(LST);
  252.     WRITELN(LST,'                        COMMENTS  SECTION');
  253.     WRITE(LST, CHR(12))
  254.   END;
  255.  
  256. PROCEDURE PRINTIT;
  257.  
  258.   VAR
  259.     SUM:REAL;
  260.  
  261.   BEGIN
  262.     WRITE(LST,(CHR(27)),(CHR(69)));        { enable Emphasized Pitch }
  263.     MAKEaBORDER(LST);
  264.     WRITELN(LST);
  265.     WRITELN(LST,'             ',PLACE,'  EMPLOYEE EVALUATION REPORT');
  266.     WRITELN(LST);
  267.     WRITELN(LST,'   Evaluation of:         ',NAME);
  268.     WRITELN(LST,'   Job Title:             ',DEPARTMENT);
  269.     WRITELN(LST,'   Evaluated on:          ',DATE);
  270.     WRITELN(LST,'   Previously Evaluated:  ',DATE2);
  271.     WRITELN(LST,'   Previous Eval. Score:  ',SCORE1:3:1);
  272.     WRITELN(LST,'   Started Working Here:  ',DATE3);
  273.     WRITELN(LST);
  274.     MAKEaBORDER(LST);
  275.     WRITELN(LST);
  276.     WRITELN(LST,'                        RATING NUMBER DEFINITI0NS');
  277.     WRITELN(LST);
  278.     WRITELN(LST,'     1 = POOR PERFORMANCE ');
  279.     WRITELN(LST,'     2 = BARELY ACCEPTABLE ');
  280.     WRITELN(LST,'     3 = ACCEPTABLE PERFORMANCE ');
  281.     WRITELN(LST,'     4 = GOOD PERFORMANCE ');
  282.     WRITELN(LST,'     5 = EXCEPTIONAL PERFORMANCE ');
  283.     WRITELN(LST);
  284.     MAKEaBORDER(LST);
  285.     WRITELN(LST);
  286.     WRITELN(LST,'     CATAGORY      RATING            COMMENTS');
  287.     WRITELN(LST);
  288.     WRITELN(LST,'     Accuracy:      ',ACCURACY:3:1,
  289.     '  ________________________________________');
  290.     WRITELN(LST,'     Knowledge:     ',KNOWLEDGE:3:1,
  291.     '  ________________________________________');
  292.     WRITELN(LST,'     Telephone:     ',TELEPHONE:3:1,
  293.     '  ________________________________________');
  294.     WRITELN(LST,'     Judgement:     ',JUDGEMENT:3:1,
  295.     '  ________________________________________');
  296.     WRITELN(LST,'     Initiative:    ',INITIATIVE:3:1,
  297.     '  ________________________________________');
  298.     WRITELN(LST,'     Planning/Org:  ',ADAPTABILITY:3:1,
  299.     '  ________________________________________');
  300.     WRITELN(LST,'     Attitude:      ',ATTITUDE:3:1,
  301.     '  ________________________________________');
  302.     WRITELN(LST,'     Attendance:    ',ATTENDANCE:3:1,
  303.     '  ________________________________________');
  304.     WRITELN(LST,'     Grooming:      ',GROOMING:3:1,
  305.     '  ________________________________________');
  306.     WRITELN(LST,'     Pt. Awareness: ',PTAWARENESS:3:1,
  307.     '  ________________________________________');
  308.     WRITELN(LST,'     Helpfulness:   ',HELPFULNESS:3:1,
  309.     '  ________________________________________');
  310.     WRITELN(LST);
  311.     WRITELN(LST,'    The highest possible rating is 55.');
  312.     WRITELN(LST,'    The lowest possible rating is 11.');
  313.     WRITELN(LST,'    The mid-range rating is 33.');
  314.     WRITELN(LST);
  315.     WRITELN(LST,'    ',NAME,' is rated at:  ',SCORE:3:1);
  316.     WRITELN(LST);
  317.     IF (SCORE <= 13) THEN
  318.       WRITELN(LST,'    ',NAME,' is a ''Poor'' performer.')
  319.     ELSE IF (SCORE <= 22) THEN
  320.       WRITELN(LST,'    ',NAME,' Just Gets By & Needs Help.')
  321.     ELSE IF (SCORE <= 43) THEN
  322.       WRITELN(LST,'    ',NAME,' does an Acceptable Job.')
  323.     ELSE IF (SCORE <= 49) THEN
  324.       WRITELN(LST,'    ',NAME,' is a Good Performer.')
  325.     ELSE
  326.       WRITELN(LST,'   ',NAME,'''s doing Exceptional Work!');
  327.     IF (SCORE1 >= 11) THEN
  328.    BEGIN
  329.     IF (SCORE) > (SCORE1) THEN
  330.       WRITELN(LST,'    ',NAME,'''s score has INCREASED from last evaluation.');
  331.    END;
  332.     IF (SCORE) < (SCORE1) THEN
  333.       WRITELN(LST,'    ',NAME,'''s score has DECREASED since last evaluation.');
  334.     SIGNitSUCKER
  335.   END;
  336.  
  337. PROCEDURE RATEthePERSON;
  338.  
  339.   BEGIN
  340.    REPEAT
  341.     GOTOXY(1,23);
  342.     HIGHVIDEO;
  343.     TEXTBACKGROUND(1);
  344.     WRITELN('A - ACCURACY');
  345.     LOWVIDEO;
  346.     TEXTBACKGROUND(1);
  347.     WRITE('  Meets quality standards of the job:              ');
  348.     HIGHVIDEO;
  349.     TEXTBACKGROUND(1);
  350.     READLN(ACCURACY);
  351.     CLEARLINES;
  352.    UNTIL (ACCURACY <= 5) AND (ACCURACY >=1);
  353.      REPEAT
  354.        GOTOXY(1,23);
  355.        WRITELN('B - JOB KNOWLEDGE');
  356.        LOWVIDEO;
  357.        TEXTBACKGROUND(1);
  358.        WRITE('  Understanding of all phases of the work:          ');
  359.        HIGHVIDEO;
  360.        TEXTBACKGROUND(1);
  361.        READLN(KNOWLEDGE);
  362.        CLEARLINES;
  363.      UNTIL (KNOWLEDGE <= 5) AND (KNOWLEDGE >=1);
  364.    REPEAT
  365.      GOTOXY(1,23);
  366.      WRITELN('C - TELEPHONE HANDLING');
  367.      LOWVIDEO;
  368.      TEXTBACKGROUND(1);
  369.      WRITE('  Handles all phone calls efficiently & pleasantly:   ');
  370.      HIGHVIDEO;
  371.      TEXTBACKGROUND(1);
  372.      READLN(TELEPHONE);
  373.      CLEARLINES;
  374.    UNTIL (TELEPHONE <= 5) AND (TELEPHONE >=1);
  375.      REPEAT
  376.        GOTOXY(1,23);
  377.        WRITELN('D - JUDGEMENT');
  378.        LOWVIDEO;
  379.        TEXTBACKGROUND(1);
  380.        WRITE
  381.        ('  Can make good independeant decisions with limited information:   ');
  382.        HIGHVIDEO;
  383.        TEXTBACKGROUND(1);
  384.        READLN(JUDGEMENT);
  385.        CLEARLINES;
  386.      UNTIL (JUDGEMENT <= 5) AND (JUDGEMENT >=1);
  387.    REPEAT
  388.      GOTOXY(1,23);
  389.      WRITELN('E - INITIATIVE');
  390.      LOWVIDEO;
  391.      TEXTBACKGROUND(1);
  392.      WRITE('  Originates constructive actions:                     ');
  393.      HIGHVIDEO;
  394.      TEXTBACKGROUND(1);
  395.      READLN(INITIATIVE);
  396.      CLEARLINES;
  397.    UNTIL (INITIATIVE <= 5) AND (INITIATIVE >=1);
  398.      REPEAT
  399.        GOTOXY(1,23);
  400.        WRITELN('F - PLANNING & ORGANIZATION');
  401.        LOWVIDEO;
  402.        TEXTBACKGROUND(1);
  403.        WRITE
  404.        ('  Anticipates problems & plans job effectively:                ');
  405.        HIGHVIDEO;
  406.        TEXTBACKGROUND(1);
  407.       READLN(ADAPTABILITY);
  408.       CLEARLINES;
  409.      UNTIL (ADAPTABILITY <=5) AND (ADAPTABILITY >=1);
  410.    REPEAT
  411.      GOTOXY(1,23);
  412.      WRITELN('G - POSITIVE ATTITUDE');
  413.      LOWVIDEO;
  414.      TEXTBACKGROUND(1);
  415.      WRITE
  416.      ('  Positive and pleasing demeanor with patients & co-workers:       ');
  417.      HIGHVIDEO;
  418.      TEXTBACKGROUND(1);
  419.      READLN(ATTITUDE);
  420.      CLEARLINES;
  421.    UNTIL (ATTITUDE <= 5) AND (ATTITUDE >=1);
  422.      REPEAT
  423.        GOTOXY(1,23);
  424.        WRITELN('H - ATTENDANCE & PUNCTUALITY');
  425.        LOWVIDEO;
  426.        TEXTBACKGROUND(1);
  427.        WRITE('  Attendance and punctuality on the job:                   ');
  428.        HIGHVIDEO;
  429.        TEXTBACKGROUND(1);
  430.        READLN(ATTENDANCE);
  431.        CLEARLINES;
  432.      UNTIL (ATTENDANCE <= 5) AND (ATTENDANCE >=1);
  433.    REPEAT
  434.      GOTOXY(1,23);
  435.      WRITELN('I - GROOMING & NEATNESS');
  436.      LOWVIDEO;
  437.      TEXTBACKGROUND(1);
  438.      WRITE('  Compliance with rules of dress & appearance:          ');
  439.      HIGHVIDEO;
  440.      TEXTBACKGROUND(1);
  441.      READLN(GROOMING);
  442.      CLEARLINES;
  443.    UNTIL (GROOMING <= 5) AND (GROOMING >=1);
  444.      REPEAT
  445.        GOTOXY(1,23);
  446.        WRITELN('J - PATIENT AWARENESS');
  447.        LOWVIDEO;
  448.        TEXTBACKGROUND(1);
  449.        WRITE
  450.        ('  Believes that patient comfort & convenience are our purpose:     ');
  451.        HIGHVIDEO;
  452.        TEXTBACKGROUND(1);
  453.        READLN(PTAWARENESS);
  454.        CLEARLINES;
  455.      UNTIL (PTAWARENESS <= 5) AND (PTAWARENESS >=1);
  456.    REPEAT
  457.      GOTOXY(1,23);
  458.      WRITELN('K - HELPFULNESS');
  459.      LOWVIDEO;
  460.      TEXTBACKGROUND(1);
  461.      WRITE('  Demonstrates willingness to learn and to help others:   ');
  462.      HIGHVIDEO;
  463.      TEXTBACKGROUND(1);
  464.      READLN(HELPFULNESS);
  465.      CLEARLINES;
  466.    UNTIL (HELPFULNESS <= 5) AND (HELPFULNESS >=1);
  467.  
  468.  END;
  469.  
  470. BEGIN                          { Main Code Portion }
  471.  
  472.   SIGNON;
  473.   MEM[$40:$17] := MEM[$40:$17] OR $40;        { sets Caps Lock on }
  474.   REPEAT
  475.     GRAPHBACKGROUND(1);
  476.     TEXTBACKGROUND(1);
  477.     CLRSCR;
  478.     ID;
  479.     SHOW;
  480.     RATEthePERSON;
  481.     SCORE := ACCURACY + KNOWLEDGE + TELEPHONE + JUDGEMENT +
  482.              INITIATIVE + ADAPTABILITY + ATTITUDE + ATTENDANCE +
  483.              GROOMING + PTAWARENESS + HELPFULNESS;
  484.  
  485.      IF (SCORE < 11) THEN
  486.        BEGIN
  487.          CLRSCR;
  488.          SOUND(100);
  489.          DELAY(500);
  490.          NOSOUND;
  491.          GOTOXY(1,10);
  492.          TEXTBACKGROUND(1);
  493.          TEXTCOLOR(4);
  494.          WRITELN
  495.        ('The score for ',NAME,' is below 11. You must really hate ',NAME,'!!');
  496.          LOWVIDEO;
  497.          TEXTBACKGROUND(1);
  498.          TEXTCOLOR(14);
  499.          WRITELN;
  500.          WRITELN('An error has been made - I''m no fool!');   { arguable }
  501.          HIGHVIDEO;
  502.          TEXTBACKGROUND(1);
  503.          WRITELN;
  504.          WRITELN('Please redo the evaluation on ',NAME);
  505.          DELAY(8000)
  506.        END
  507.    ELSE IF (SCORE > 55) THEN
  508.      BEGIN
  509.        TEXTBACKGROUND(1);
  510.        TEXTCOLOR(4);
  511.        WRITELN('Hey! I know you like ',NAME,' but the score is above 55!!');
  512.        LOWVIDEO;
  513.        TEXTBACKGROUND(1);
  514.        WRITELN(' I think you made an error.');
  515.        HIGHVIDEO;
  516.        TEXTBACKGROUND(1);
  517.        WRITELN('Please redo the evaluation on ',NAME);
  518.        DELAY(8000)
  519.      END
  520.    ELSE
  521.      BEGIN
  522.        TEXTBACKGROUND(1);
  523.        TEXTCOLOR(0);
  524.        WRITELN;
  525.        WRITELN;
  526.        WRITELN(NAME,' has a score of ',SCORE:3:1);
  527.        WRITELN;
  528.        TEXTCOLOR(14);
  529.        WRITE('Do you want a hard copy for full details?  (Y/N): ');
  530.        READ(KBD,CH);
  531.        IF CH IN ['Y','y'] THEN
  532.          BEGIN
  533.            TEXTBACKGROUND(1);
  534.            CLRSCR;
  535.            GOTOXY(15,20);
  536.            TEXTCOLOR(20);
  537.            DELAY(500);
  538.            SOUND(1000);
  539.            DELAY(700);
  540.            SOUND(400);
  541.            DELAY(1000);
  542.            NOSOUND;
  543.            DELAY(500);
  544.            WRITELN('          --- BE SURE PRINTER IS TURNED ON ---');
  545.            WRITELN;
  546.            WRITELN;
  547.            TEXTCOLOR(0);
  548.            WRITE('             Press any key when Printer is ready');
  549.            READ(KBD,CH);
  550.            CLRSCR;
  551.            GRAPHBACKGROUND(1);
  552.            TEXTBACKGROUND(1);
  553.            GOTOXY(10,15);
  554.            TEXTCOLOR(14);
  555.            WRITELN('                 *** PRINTING NOW BEING DONE ***');
  556.            PRINTIT;
  557.            WRITELN(LST, (CHR(27)), (CHR(70)));
  558.            WRITELN
  559.          END;
  560.        WRITELN;
  561.        WRITELN;
  562.        TEXTCOLOR(0);
  563.        WRITE('Do you want to do another evaluation? (Y/N):  ');
  564.        READ(KBD,CH)
  565.      END;
  566.    UNTIL CH IN ['N','n'];
  567.    CLOSE(LST);
  568.    LBCOAT;       { if compiling to memory or using EVALUATE as a }
  569. END.             { free standing .COM file, remove this LBCOAT call }
  570.  
  571.  
  572.      { A LOT of credit to Dr. Leon Wortman's Turbo Pascal Programming }
  573.      { with Applications - the core ideas in this code are adapted    }
  574.      { from his excellent text, a good buy in my opinion (TAB Books). }
  575.  
  576.